Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-04/forthcmp.zip/DRIVER.4TH

Text File | 1992-03-30 | 7KB | 253 lines

\ Example code for a device driver
\ See Advanced MSDOS Programming, by Ray Duncan (Microsoft Press)
\  for details of driver writing

\ You can use this driver as a skeleton. It is set up as a demonstration
\ character device driver which consists of a circular buffer that can
\ be read and written. But all entry point routines are provided


0 DRIVER
24 CONSTANT MaxCmd    \ number of commands to respond to in table

HEX
H: RETF  0CB C, ;    \ Far return instruction for assembler

NEED Strat  NEED Intr


-1 , -1 ,    \ driver header
08800 ,        \ device attribute word, "generic" driver for DOS 3 or later
', Strat        \ strategy routine offset
', Intr         \ interrupt routine offset
," SKELETON"    \ eight character device name

2VARIABLE RHPtr    \ segment/offset of request

\ Dispatched functions will return STATUS, with "done" bit set
\ automatically (this means that most functions will return 0)

0 1 IN/OUT  NEED Init
0 1 IN/OUT  NEED MediaChk
0 1 IN/OUT  NEED BuildBPB
0 1 IN/OUT  NEED IoctlRd
0 1 IN/OUT  NEED Read
0 1 IN/OUT  NEED NdRead
0 1 IN/OUT  NEED InpStat
0 1 IN/OUT  NEED InpFlush
0 1 IN/OUT  NEED Write
0 1 IN/OUT  NEED WriteVfy
0 1 IN/OUT  NEED OutStat
0 1 IN/OUT  NEED OutFlush
0 1 IN/OUT  NEED IoctlWt
0 1 IN/OUT  NEED DevOpen
0 1 IN/OUT  NEED DevClose
0 1 IN/OUT  NEED RemMedia
0 1 IN/OUT  NEED OutBusy
0 1 IN/OUT  NEED Error
0 1 IN/OUT  NEED GenIOCTL
0 1 IN/OUT  NEED GetLogDev
0 1 IN/OUT  NEED setLogDev


CREATE Dispatch  \ dispatch table for commands, Error entries are invalid
', Init ', MediaChk ', BuildBPB ', IoctlRd
', Read ', NdRead ', InpStat ', InpFlush
', Write ', WriteVfy ', OutStat ', OutFlush
', IoctlWt ', DevOpen ', DevClose ', RemMedia
', OutBusy ', Error ', Error ', GenIOCTL
', Error ', Error ', Error ', GetLogDev
', setLogDev

CODE Strat    \ Strategy routine just saves request block address
    BX CS: RHPtr [] MOV
    CS: RHPtr 2+ [] ES <SEG
    RETF
END-CODE

\ handle data/stack memory needed for Forth
VARIABLE DP       ( start free ram = HERE )
VARIABLE S0       ( top of stack )
VARIABLE R0       ( top of return stack )
VARIABLE BASE  0A BASE ! ( initialized at compile time )

2VARIABLE OLDSTACK

80 ALLOT HERE S0 ! ( parameter stack -- may need to be bigger )
80 ALLOT HERE R0 ! ( return stack--may need to be bigger )

0 0 IN/OUT  NEED INTR

CODE Intr
    AX PUSH BX PUSH CX PUSH DX PUSH SI PUSH DI PUSH BP PUSH
    DS PUSHSEG ES PUSHSEG    \ save all but stack here
    AX CS <SEG AX DS >SEG    \ establish adressability

    OLDSTACK 2+ [] SS <SEG   SP OLDSTACK [] MOV \ save old stack
    AX SS >SEG
    S0 @ # SP MOV    \ set new stack
    R0 @ # BP MOV    \ and return stack

    RHPtr [] DI LES    \ command block
    ES: 2 +[DI] BL MOV  \ command code
    BH BH XOR
    MaxCmd # BX CMP >S ~ IF,    \ command in range
        BX 1 SHL  Dispatch +[BX] CALLI
    ELSE,
        CALL' Error
    THEN,
    RHPtr [] DI LES    \ command block
    100 # AX OR  AX  ES: 3 +[DI] MOV    \ set status field

    OLDSTACK 2+ [] SS >SEG   OLDSTACK [] SP MOV \ restore old stack
    ES POPSEG DS POPSEG
        BP POP DI POP SI POP DX POP CX POP BX POP AX POP
    RETF
END-CODE


\ Default routines -- these return "success"
\  since there is no code inside, they will fall through to the commmon
\  code in the last definition, which is made a colon definition.
\  If you intend to have the function actually do something, then
\  move the definition elsewhere!



CODE MediaChk     END-CODE    \ not used for character devices-- return done
CODE BuildBPB     END-CODE    \ not used for character devices-- return done
CODE IoctlRd     END-CODE    \ disabled in header word
\ CODE Read     END-CODE    \ implemented below
\ CODE NdRead     END-CODE    \ implemented below
\ CODE InpStat     END-CODE    \ implemented below
\ CODE InpFlush    END-CODE    \ implemented below
\ CODE Write     END-CODE    \ implemented below
\ CODE WriteVfy END-CODE    \ implemented below
\ CODE OutStat     END-CODE    \ implemented below
\ CODE OutFlush    END-CODE    \ Not used in this example -- always success
CODE IoctlWt     END-CODE    \ disabled in header word
CODE DevOpen     END-CODE    \ disabled in header word
CODE DevClose     END-CODE    \ disabled in header word
CODE RemMedia    END-CODE    \ disabled in header word
CODE OutBusy     END-CODE    \ disabled in header word
CODE GenIOCTL     END-CODE    \ disabled in header word
CODE GetLogDev    END-CODE    \ not used for character devices-- return done
CODE setLogDev    END-CODE    \ not used for character devices-- return done
0 1 IN/OUT
: SUCCESS  0 ;

\ The error routine for invalid codes
: Error  8003 ;

\
\ The actual SKELETON device driver follows.
\

CREATE CIRBUF 100 ALLOT    \ the circular buffer
HERE CONSTANT CIREND

VARIABLE INPTR  CIRBUF INPTR !        \ pointer for reading
VARIABLE OUTPTR  CIRBUF OUTPTR !    \ pointer for writing
VARIABLE TMP
VARIABLE TMP2

: Read         \ read characters, returns control-Z at "End of File"
        \ since otherwise this driver would hang forever!
    TMP OFF    \ use for read count
    RHPtr 2@ 2DUP 0E + 2@L 2SWAP 12 + @L    \ farbuffer addr and length
    0 ?DO   1 TMP +!
        INPTR @ OUTPTR @ = IF \ nothing left
            2DUP CONTROL Z -ROT C!L    \ indicate EOF
            LEAVE THEN
        2DUP INPTR @ C@ -ROT C!L \ store the character
        1+    \ increment farbuffer pointer
        INPTR @ 1+ DUP CIREND =     \ circularly increment INPTR
            IF DROP CIRBUF THEN INPTR !
    LOOP
    2DROP    \ the buffer address
    TMP @  RHPtr 2@ 12 + !L    \ actual characters read
    0
;

: NdRead    \ peek for any available character
    INPTR @ OUTPTR @ <> IF \ character available
        INPTR @ C@  RHPtr 2@ 0D + C!L \ get the character
        0    \ returns status saying it is available
        EXIT
    THEN
    200    \ return busy bit set -- no character available
;

: InpStat    \ check for available character
    INPTR @ OUTPTR @ <> IF \ character available
        0
        EXIT
        THEN
    200    \ return busy bit set if none available
;

: InpFlush    \ Flush input buffer -- here, discards all available data
    INPTR @ OUTPTR !
;

CODE WriteVfy END-CODE    \ do Write for WriteVfy

: Write        \ write characters to buffer -- give error if we overflow
    TMP OFF    \ use for write count
    TMP2 OFF    \ set if error
    RHPtr 2@ 2DUP 0E + 2@L 2SWAP 12 + @L    \ farbuffer addr and length
    0 ?DO   1 TMP +!
        2DUP C@L OUTPTR @ C! \ store the character
        1+    \ increment farbuffer pointer
        OUTPTR @ 1+ DUP CIREND =     \ circularly increment OUTPTR
            IF DROP CIRBUF THEN
        DUP INPTR @ = IF \ trouble -- buffer overflows
            800A TMP2 !    \ Write error
            -1 TMP +!
            DROP
            LEAVE THEN
        OUTPTR !    \ success!
    LOOP
    2DROP    \ the buffer address
    TMP @  RHPtr 2@ 12 + !L    \ actual characters read
    TMP2 @  \ return error code
;

: OutStat    \ Output status -- can we write?
    OUTPTR @ 1+ DUP CIREND = IF DROP CIRBUF THEN INPTR @ = IF
        200 \ set busy bit if buffer is full
        EXIT
        THEN
    0
;

INCLUDE FORTHLIB
HEX

\
\ INITIALIZATION CODE
\
\ What follows will be not be part of the file after installing
\  the driver.

CODE EMIT    \ rewrite EMIT to use acceptable system call
    AL DL MOV
    2 # AH MOV
    21 INT
    RET
END-CODE

: Init
    ." Skeleton driver -- Just for demonstration" CR
    ." Loaded at " HEX ?CS: 0 <# # # # # #> TYPE ." :0000" CR
    ." Size is " ['] EMIT DECIMAL  U. ." (decimal) bytes." CR
    ." But is " HERE U. ." bytes at load time." CR

    ?CS: ['] EMIT RHPtr 2@ 0E + 2!L    \ store address of driver end

    0
;

INCLUDE FORTHLIB   \ read it in again to resolve extra functions
END